home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / simula / compiler / cim / sun4cim.lha / cimtest.sim < prev    next >
Text File  |  1993-02-04  |  31KB  |  263 lines

  1. SimSet begin class Flink(MaxInstr, MaxIntt, MaxReal); integer MaxInstr, MaxIntt, MaxReal;
  2. begin real array RStore(0:MaxReal); integer array Func, Adrs, Corr(0:MaxInstr),
  3. IStore(0:MaxIntt); real R; integer I, C, CF, CA, CC, PC; integer TotalTid;
  4. procedure DumpRegs; begin OutImage; SetPos( 1); OutText("I = "); OutNum(I);
  5. SetPos(21); OutText("C = "); OutNum(C); SetPos(41); OutText("PC = "); OutNum(PC); OutImage; SetPos( 1); OutText("CF = "); OutNum(CF); SetPos(21); OutText("CA = "); OutNum(CA);
  6. SetPos(41); OutText("CC = "); OutNum(CC); OutImage; end DumpRegs; procedure DumpIStore; begin
  7. integer Inx; OutImage; OutText("IStore:"); for Inx := 0 step 1 until MaxIntt do begin if Mod(Inx,6) = 0 then begin
  8. OutImage; OutInt(Inx,4); OutText(": "); end; OutInt(IStore(Inx), 11);
  9. end for; OutImage; end DumpIStore; procedure DumpRStore;
  10. begin integer Inx; OutImage; OutText("RStore:"); for Inx := 0 step 1 until MaxReal do begin
  11. if Mod(Inx,5) = 0 then begin OutImage; OutInt(Inx,4); OutText(": "); end;
  12. OutReal(RStore(Inx), 8, 14); end for; OutImage; end DumpRStore;
  13. procedure OutNum(N); integer N; begin if N < 0 then begin
  14. OutChar('-'); OutNum(-N); end else begin if N > 9 then OutNum(N//10); OutChar(Char(Rank('0') + Mod(N,10)));
  15. end; end OutNum; procedure Run; begin
  16. integer Tid, FinAddr; switch Instr := STOP, LDI, STI, LDC, STC, ADDI, SUBI, MULI, DIVI, INI, OUTI, OLIN, JMP, JRC, JLTI, JLEI, JEQI, JNEI,
  17. JGTI, JGEI, SETI, INCI, SETC, INCC, CIC, CCI, LDR, STR, ADDR, SUBR, MULR, DIVR, INR, OUTR, JLTR, JLER, JEQR, JNER, JGER, JGTR, ZROR, CIR, CRI; Tid := 0;
  18. Next: TotalTid := TotalTid+Tid; Tid := 0; CF := Func(PC); CA := Adrs(PC); CC := Corr(PC); PC := PC+1; FinAddr := CA;
  19. if CC <> 0 then FinAddr := FinAddr+C; if CF < 0 or CF > 42 then begin OutText("Ulovlig instruksjonskode: "); OutNum(CF); OutImage; goto StopRun;
  20. end; goto Instr(CF+1); STOP: Tid := 1; goto StopRun; LDI: I := IStore(FinAddr); Tid := 2; goto Next;
  21. STI: IStore(FinAddr) := I; Tid := 2; goto Next; LDC: C := IStore(FinAddr); Tid := 2; goto Next; STC: IStore(FinAddr) := C; Tid := 2; goto Next; ADDI: I := I + IStore(FinAddr); Tid := 2; goto Next;
  22. SUBI: I := I - IStore(FinAddr); Tid := 2; goto Next; MULI: I := I * IStore(FinAddr); Tid := 10; goto Next; DIVI: if IStore(FinAddr) = 0 then begin OutImage;
  23. OutText("Integer division by zero."); OutImage; goto StopRun; end; I := I // IStore(FinAddr); Tid := 15; goto Next;
  24. INI: OutText("Integer value> "); BreakOutImage; InImage; I := InInt; Tid := 100; goto Next; OUTI: OutInt(I, FinAddr); Tid := 50; goto Next; OLIN: OutImage; Tid := 50; goto Next;
  25. JMP: PC := FinAddr; Tid := 1; goto Next; JRC: C := PC; PC := FinAddr; Tid := 1; goto Next; JLTI: if I < 0 then PC := FinAddr; Tid := 1; goto Next; JLEI: if I <= 0 then PC := FinAddr; Tid := 1; goto Next;
  26. JEQI: if I = 0 then PC := FinAddr; Tid := 1; goto Next; JNEI: if I <> 0 then PC := FinAddr; Tid := 1; goto Next; JGTI: if I > 0 then PC := FinAddr; Tid := 1; goto Next; JGEI: if I >= 0 then PC := FinAddr; Tid := 1; goto Next;
  27. SETI: I := FinAddr; Tid := 1; goto Next; INCI: I := I + FinAddr; Tid := 1; goto Next; SETC: C := FinAddr; Tid := 1; goto Next; INCC: C := C + FinAddr; Tid := 1; goto Next;
  28. CIC: C := I; Tid := 1; goto Next; CCI: I := C; Tid := 1; goto Next; LDR: R := RStore(FinAddr); Tid := 10; goto Next; STR: RStore(FinAddr) := R; Tid := 10; goto Next;
  29. ADDR: R := R + RStore(FinAddr); Tid := 10; goto Next; SUBR: R := R - RStore(FinAddr); Tid := 10; goto Next; MULR: R := R * RStore(FinAddr); Tid := 15; goto Next; DIVR: if Rstore(FinAddr) = 0 then begin
  30. OutImage; OutText("Real division by zero."); OutImage; goto StopRun; end;
  31. R := R / RStore(FinAddr); Tid := 20; goto Next; INR: OutText("Real value> "); BreakOutImage; InImage; R := InReal; Tid := 150; goto Next; OUTR: OutFix(R, I, FinAddr); Tid := 100; goto Next;
  32. JLTR: if R < 0 then PC := FinAddr; Tid := 10; goto Next; JLER: if R <= 0 then PC := FinAddr; Tid := 10; goto Next; JEQR: if R = 0 then PC := FinAddr; Tid := 10; goto Next; JNER: if R <> 0 then PC := FinAddr; Tid := 10; goto Next;
  33. JGER: if R >= 0 then PC := FinAddr; Tid := 10; goto Next; JGTR: if R > 0 then PC := FinAddr; Tid := 10; goto Next; ZROR: R := 0; Tid := 1; goto Next; CIR: R := I; Tid := 20; goto Next;
  34. CRI: I := R; Tid := 20; goto Next; StopRun: TotalTid := TotalTid+Tid; if CF<>0 or FinAddr<>0 then DumpRegs; end Run;
  35.  PC := 0; I := 0; C := 0; TotalTid := 0; end Flink; ref(Flink) FM;
  36. ref(OutFile) ListeFil; integer TestMarg1, TestMarg2; boolean RTestUtskrift,
  37. FTestUtskrift, NTestUtskrift, STestUtskrift, TTestUtskrift;
  38. procedure Feil1(T); text T; begin Feil4(T, notext, notext, notext);
  39. end Feil1; procedure Feil2(T1, T2); text T1, T2; begin
  40. Feil4(T1, T2, notext, notext); end Feil2; procedure Feil3(T1, T2, T3); text T1, T2, T3;
  41. begin Feil4(T1, T2, T3, notext); end Feil3; procedure Feil4(T1, T2, T3, T4);
  42. value T1; text T1, T2, T3, T4; begin Tgen.SkrivLinjen(SysOut);
  43. UpCase(T1.Sub(1,1)); OutText("*** Feil: "); OutText(T1); OutText(T2); OutText(T3); OutText(T4); OutChar('.'); OutImage; inspect ListeFil do begin
  44. OutText("*** Feil: "); OutText(T1); OutText(T2); OutText(T3); OutText(T4); OutChar('.'); OutImage; end inspect; goto Avslutt;
  45. end Feil4; ref(TegnGenerator) Tgen; character NT; class TegnGenerator;
  46. hidden protected F, LinjeNr, NesteNT, NyttTegn; begin text F; integer LinjeNr;
  47. character NesteNT; procedure SkrivLinjen(UtF); ref(OutFile) UtF; begin
  48. end SkrivLinjen; procedure LukkFil; begin comment Lukk filen F. ;
  49. end LukkFil; procedure NyttTegn(C); character C; begin
  50. comment Et nytt tegn er klar til } sendes videre til Sgen. --"-- Unng} } sende flere blanke etter hverandre. --"-- Gi testutskrift (om |nsket) og send tegnet. ; if NT=' ' and C=' ' then begin
  51. comment Unng} } sende lange sekvenser av blanke. Denne blanke b|r --"-- derfor bare ignoreres. ; end else begin if TTestUtskrift then begin
  52. inspect ListeFil do begin SetPos(TestMarg1); OutText("---T '"); OutChar(C); OutText("' (Rank="); OutInt(Rank(C),3); OutText(")"); OutImage; end inspect;
  53. end if; NT := C; Detach; end if; end NyttTegn;
  54. F:-"prog " & " " & " var sil(40); " & " var i,k; " &
  55. " " & " var stor; " & " " & " " &
  56. " proc fjern in m; " & " var i; " & " begproc " & " i := 2*m; " &
  57. " while i<=40 do " & " sil(i) := 0; " & " i := i+m; " & " endwhile; " &
  58. " endproc; " & " " & "begprog " & " " &
  59. " " & " stor := 1000000; " & " " & " i := 0; " &
  60. " while i<=40 do " & " sil(i) := 1; " & " i := i+1; " & " endwhile; " &
  61. " " & " " & " k := 2; " & " while k<7 do " &
  62. " call fjern with k; " & " k := k+1; " & " endwhile; " & " " &
  63. " " & " if sil(2)<>1 then i := sil(stor); endif; " & " if sil(3)<>1 then i := sil(stor); endif; " & " if sil(5)=/=1 then i := sil(stor); endif; " &
  64. " if sil(7)=/=1 then i := sil(stor); endif; " & " if sil(11)=/=1 then i := sil(stor); endif; " & " if sil(13)=/=1 then i := sil(stor); endif; " & " if sil(17)=/=1 then i := sil(stor); endif; " &
  65. " if sil(19)=/=1 then i := sil(stor); endif; " & " if sil(23)=/=1 then i := sil(stor); endif; " & " if sil(29)=/=1 then i := sil(stor); endif; " & " if sil(31)=/=1 then i := sil(stor); endif; " &
  66. " if sil(37)=/=1 then i := sil(stor); endif; " & " " & " if sil(9)=0 then " & " else i := sil(stor); endif; " &
  67. " if sil(25)=0 then " & " else i := sil(stor); endif; " & " " & " i := 2; " &
  68. " while i<41 do " & " if sil(i)=1 then outint(4)i; endif; " & " i := i+1; " & " endwhile; " &
  69. " " & "endprog; "; Detach; while F.More do begin
  70. NesteNT := F.GetChar; if NesteNT = '-' and F.More then begin NesteNT := F.GetChar; NyttTegn('-'); NyttTegn(NesteNT);
  71. end else begin NyttTegn(NesteNT); end if; end while;
  72. Feil1("Slutten av programmet mangler"); end TegnGenerator; Link class Navn(Id, Nr); value Id;
  73. text Id; integer Nr; begin end Navn;
  74. ref(Head) NavneTab; integer procedure TallAvNavn(T); text T; begin
  75. ref(Navn) NP; integer NyttNr; boolean Funnet; NP :- NavneTab.First;
  76. while NP=/=none and not Funnet do begin if NP.Id = T then Funnet := true else NP :- NP.Suc; end while;
  77. if Funnet then begin TallAvNavn := NP.Nr; end else begin TallAvNavn := NyttNr := NavneTab.Cardinal+1;
  78. new Navn(T,NyttNr).Into(NavneTab); if NTestUtskrift then begin inspect ListeFil do begin SetPos(TestMarg1); OutText("---N Nytt navn (nr."); OutInt(NyttNr,4);
  79. OutText("): "); OutText(T); OutImage; end inspect; end if; end inspect;
  80. end TallAvNavn; text procedure NavnAvTall(N); integer N; begin
  81. ref(Navn) NP; boolean Funnet; NP :- NavneTab.First; while NP=/=none and not Funnet do begin
  82. if NP.Nr = N then Funnet := true else NP :- NP.Suc; end while; NavnAvTall :- Copy(if NP == none then "???" else NP.Id);
  83. end NavnAvTall; boolean procedure ErNokkelord(N); integer N; begin
  84. ErNokkelord := N <= Hwith; end ErNokkelord; Link class Deklarasjon(Navn, Adresse); integer Navn, Adresse;
  85. begin end Deklarasjon; Deklarasjon class VarDeklarasjon;; Deklarasjon class VektorDeklarasjon;;
  86. Deklarasjon class ProsedyreDeklarasjon; begin boolean HarInnParam, HarUtparam; end ProsedyreDeklarasjon;
  87. ref(Head) LokalDeklListe, GlobalDeklListe; boolean ErIProsedyre; ref(Deklarasjon) procedure LetIDeklListe(Liste, Id); ref(Head) Liste;
  88. integer Id; begin comment Let i angitt deklarasjons-liste etter Id. ; ref(Deklarasjon) D;
  89. boolean Funnet; D :- Liste.First; while D=/=none and not Funnet do begin if D.Navn = Id then Funnet := true
  90. else D :- D.Suc; end while; LetIDeklListe :- D; end LetIDeklListe;
  91. procedure NyDeklarasjon(D); ref(Deklarasjon) D; begin comment Sett en ny deklarasjon inn i tabellen i riktig liste. ;
  92. ref(Head) Liste; Liste :- if ErIProsedyre then LokalDeklListe else GlobalDeklListe; if LetIDeklListe(Liste,D.Navn) =/= none then Feil2(NavnAvTall(D.Navn), " er allerede deklarert");
  93. D.Into(Liste); end NyDeklarasjon; ref(Deklarasjon) procedure FinnDeklarasjon(Id); integer Id;
  94. begin ref(Deklarasjon) Dekl; if ErIProsedyre then Dekl :- LetIDeklListe(LokalDeklListe, Id); if Dekl == none then Dekl :- LetIDeklListe(GlobalDeklListe, Id);
  95. if Dekl == none then Feil2(NavnAvTall(Id), " er ikke deklarert"); FinnDeklarasjon :- Dekl; end FinnDeklarasjon; procedure InnIProsedyre;
  96. begin if ErIProsedyre then Feil1("Det er ulovlig } deklarere en prosedyre inne i en annen"); ErIProsedyre := true;
  97. end InnIProsedyre; procedure UtAvProsedyre; begin LokalDeklListe.Clear; ErIProsedyre := false;
  98. end UtAvProsedyre; ref(SymbolGenerator) Sgen; integer HS, BS; integer Hbegproc, Hbegprog, Hcall, Hdo, Helse, Hendif, Hendproc, Hendprog,
  99. Hendwhile, Hif, Hin, Hinint, Hinto, Hout, Houtint, Houtline, Hproc, Hprog, Hthen, Hvar, Hwhile, Hwith, Hnavn, Hkonst, Haritop, Hsammenlign, Hvenstrepar, Hhoyrepar, Hkomma, Hsemikolon, Htilordn; integer Bpluss, Bminus, Bganger, Bdivisjon, Bmindre, Bmindrelik, Blik, Bulik,
  100. Bstorre, Bstorrelik; class SymbolGenerator; hidden protected DetteSy, NyttSy; begin
  101. text DetteSy; procedure NyttSy(H, B, Sy); text Sy; integer H, B;
  102. begin comment Et nytt symbol er klart. Lag test-utskrift (om |nsket), --"-- og send symbolet videre til Fgen. ; if STestUtskrift then begin
  103. inspect ListeFil do begin SetPos(TestMarg1); OutText("---S "); OutInt(H,3); OutInt(B,11); SetPos(Pos+2); OutText(Sy); OutImage; end inspect;
  104. end if; HS := H; BS := B; Detach; end NyttSy; procedure LesNavn;
  105. begin comment Leser et navn (som ogs} kan v{re et reservert ord). ; text Id; integer IdNum;
  106. Id :- Blanks(80); while Letter(NT) or Digit(NT) do begin Id.PutChar(NT); Call(Tgen); end while;
  107. Id :- UpCase(Id.Strip); IdNum := TallAvNavn(Id); if ErNokkelord(IdNum) then NyttSy(IdNum,0,Id) else NyttSy(Hnavn,IdNum,Id);
  108. end LesNavn; procedure LesKonstant; begin comment Leser en numerisk konstant. ;
  109. text Buf; Buf :- Blanks(9); while Digit(NT) do begin if not Buf.More then
  110. Feil3("Numerisk konstant `", Buf, "..' er for stor"); Buf.PutChar(NT); Call(Tgen); end while; NyttSy(Hkonst,Buf.GetInt,Buf);
  111. end LesKontant; Detach; Call(Tgen); while true do begin
  112. while NT = ' ' do Call(Tgen); if Letter(NT) then LesNavn else if Digit(NT) then LesKonstant else if NT = '+' then begin NyttSy(Haritop,Bpluss,"+"); Call(Tgen) end else
  113. if NT = '-' then begin NyttSy(Haritop,Bminus,"-"); Call(Tgen) end else if NT = '*' then begin NyttSy(Haritop,Bganger,"*"); Call(Tgen) end else if NT = '/' then begin NyttSy(Haritop,Bdivisjon,"/"); Call(Tgen) end else if NT = '(' then begin NyttSy(Hvenstrepar,0,"("); Call(Tgen) end else
  114. if NT = ')' then begin NyttSy(Hhoyrepar,0,")"); Call(Tgen) end else if NT = ',' then begin NyttSy(Hkomma,0,","); Call(Tgen) end else if NT = ';' then begin NyttSy(Hsemikolon,0,";"); Call(Tgen) end else if NT = '<' then begin
  115. Call(Tgen); if NT = '=' then begin NyttSy(Hsammenlign,Bmindrelik,"<="); Call(Tgen); end else
  116. if NT = '>' then begin NyttSy(Hsammenlign,Bulik,"<>"); Call(Tgen); end else NyttSy(Hsammenlign,Bmindre,"<"); end else
  117. if NT = '=' then begin Call(Tgen); if NT = '/' then begin Call(Tgen);
  118. if NT = '=' then begin NyttSy(Hsammenlign,Bulik,"<>"); Call(Tgen); end else Feil3("Ulovlig tegn-kombinasjon: `=/", TextAvChar(NT), "'"); end else NyttSy(Hsammenlign,Blik,"=");
  119. end else if NT = '>' then begin Call(Tgen); if NT = '=' then begin
  120. NyttSy(Hsammenlign,Bstorrelik,">="); Call(Tgen); end else NyttSy(Hsammenlign,Bstorre,">"); end else if NT = ':' then begin
  121. Call(Tgen); if NT = '=' then begin NyttSy(Htilordn,0,":="); Call(Tgen); end else Feil3("Ulovlig tegn-kombinasjon: `:", TextAvChar(NT), "'");
  122. end else Feil3("Ulovlig tegn: `", TextAvChar(NT), "'"); end while; end SymbolGenerator; class VarInfo(Adresse);
  123. integer Adresse; begin comment Klasse (brukt av Fgen) for } lagre informasjon om en variabel- --"-- forekomst i Minila-programmet. Foruten variabelens Adresse
  124. --"-- lagres f|lgende opplysninger: --"-- Indeksert: `true' hvis variabelen var indeksert (f.eks. `A(I)'), --"-- `false' hvis kun en vanlig variabel (f.eks. `B'). --"-- VarIndeks: `true' hvis indeksen var en variabel (som i `A(I)'),
  125. --"-- `false' hvis indeksen var en konstant (som i `A(5)'). --"-- IndeksAdr: Indeks-variabelens adresse --"-- (kun aktuelt hvis Indeksert & VarIndeks). --"-- IndeksVerdi: Indeks-konstantens verdi
  126. --"-- (kun aktuelt hvis Indeksert & not Varindeks). ; integer IndeksAdr, IndeksVerdi; boolean Indeksert, VarIndeks; end VarInfo;
  127. ref(FlinkGenerator) Fgen; class FlinkGenerator; hidden protected Synlig; begin
  128. boolean Synlig; text array InstrNavn(0:25); integer array AritOpKode(1:4), BetOpKode(1:6);
  129. integer NesteInstr, NesteInt, ProcNivaa, TempUttrykk,
  130. TempBetingelse; integer Istop, Ildi, Isti, Ildc, Istc, Iaddi, Isubi, Imuli, Idivi, Iini, Iouti, Iolin, Ijmp, Ijrc, Ijlti, Ijlei, Ijeqi, Ijnei, Ijgti, Ijgei, Iseti, Iinci, Isetc, Iincc, Icic, Icci;
  131. procedure TestProc1(ProcId); text ProcId; begin comment Programmet er g}tt inn i en ny analyse-prosedyre.
  132. --"-- Gi en passende testutskrift. ; integer I; inspect ListeFil do begin SetPos(TestMarg1); OutText("---R ");
  133. for I := 1 step 1 until ProcNivaa do OutText(" "); OutText("Start "); OutText(ProcId); OutImage; end inspect; ProcNivaa := ProcNivaa+1;
  134. end TestProc1; procedure TestProc2(ProcId); text ProcId; begin
  135. comment Programmet er g}tt ut av en analyse-prosedyre. --"-- Gi en passende testutskrift. ; integer I; ProcNivaa := ProcNivaa-1;
  136. inspect ListeFil do begin SetPos(TestMarg1); OutText("---R "); for I := 1 step 1 until ProcNivaa do OutText(" "); OutText("Slutt "); OutText(ProcId); OutImage;
  137. end inspect; end TestProc2; procedure LagInstr(FK, AK, CK); integer FK, AK, CK;
  138. begin comment Genererer en Flink-instruksjon. ; if NesteInstr > FM.MaxInstr then Feil2("Programmet er for langt, ",
  139. "det er ikke nok plass i Flinks's instruksjonslager"); inspect FM do begin Func(NesteInstr) := FK; Adrs(NesteInstr) := AK; Corr(NesteInstr) := CK; end inspect;
  140. if FTestUtskrift then begin inspect ListeFil do begin SetPos(TestMarg2); OutText("---F"); OutInt(NesteInstr,14); OutText(": "); OutText(InstrNavn(FK));
  141. SetPos(TestMarg2+24); OutInt(AK,12); IF CK=1 then OutText(" *"); OutImage; end inspect; end if;
  142. NesteInstr := NesteInstr+1; end LagInstr; procedure LagHentVar(VI); ref(VarInfo) VI;
  143. begin comment Lager kode for } hente variabelen VI inn i I-reg. ; if VI.Indeksert then begin if VI.VarIndeks then LagInstr(Ildc, VI.IndeksAdr, 0)
  144. else LagInstr(Isetc, VI.IndeksVerdi, 0); end if; LagInstr(Ildi, VI.Adresse, if VI.Indeksert then 1 else 0); end LagHentVar;
  145. procedure LagSettVar(VI); ref(VarInfo) VI; begin comment Lager kode for } sette verdien i I-reg ned i variabelen VI. ;
  146. if VI.Indeksert then begin if VI.VarIndeks then LagInstr(Ildc, VI.IndeksAdr, 0) else LagInstr(Isetc, VI.IndeksVerdi, 0); end if;
  147. LagInstr(Isti, VI.Adresse, if VI.Indeksert then 1 else 0); end LagSettVar; procedure FyllGammelAdr(Lok, NyAdr); integer Lok, NyAdr;
  148. begin comment Opdater adresse-delen av den tidligere genererte instruksjonen --"-- i lokasjonen Lok til } v{re NyAdr. ; FM.Adrs(Lok) := NyAdr;
  149. if FTestUtskrift then begin inspect ListeFil do begin SetPos(TestMarg2); OutText("---F"); OutInt(Lok,14); OutText(">>>"); OutInt(NyAdr,15); OutImage;
  150. end inspect; end if; end FyllGammelAdr; integer procedure SettAvKonstant(Verdi);
  151. integer Verdi; begin comment Sett inn en ny konstant i Flink's heltallslager. --"-- Returner den nye konstantens adresse. ;
  152. if NesteInt > FM.MaxIntt then Feil1("Ikke mer plass i Flink's heltallslager"); if FTestUtskrift then begin inspect ListeFil do begin
  153. SetPos(TestMarg2); OutText("---F K"); OutInt(NesteInt,11); OutText(": "); OutInt(Verdi,16); OutImage; end inspect; end if;
  154. FM.IStore(NesteInt) := Verdi; SettAvKonstant := NesteInt; NesteInt := NesteInt+1; end SettAvKonstant; integer procedure SettAvVariabel(Id);
  155. integer Id; begin comment Sett av plass i Flink's heltallslager til en ny variabel. --"-- Returner den nye variabelens adresse. ;
  156. if NesteInt > FM.MaxIntt then Feil1("Ikke mer plass i Flink's heltallslager"); if FTestUtskrift then begin inspect ListeFil do begin
  157. SetPos(TestMarg2); OutText("---F V"); OutInt(NesteInt,11); OutText(": "); OutText(NavnAvTall(Id)); OutImage; end inspect; end if;
  158. SettAvVariabel := NesteInt; NesteInt := NesteInt+1; end SettAvVariabel; integer procedure SettAvVektor(AntElem, Id); integer AntElem, Id;
  159. begin comment Sett av plass i Flink's heltallslager til en ny vektor. --"-- Returner den nye vektorens start-adresse. ; if NesteInt+AntElem > FM.MaxIntt+1 then
  160. Feil1("Ikke mer plass i Flink's heltallslager"); if FTestUtskrift then begin inspect ListeFil do begin SetPos(TestMarg2); OutText("---F A"); OutInt(NesteInt,5);
  161. OutChar('-'); OutInt(NesteInt+AntElem-1,5); OutText(": "); OutText(NavnAvTall(Id)); OutImage; end inspect; end if;
  162. SettAvVektor := NesteInt; NesteInt := NesteInt+AntElem; end SettAvVektor; procedure Forvent(Sy); integer Sy;
  163. begin comment Forvent } finne symbolet Sy. Hvis HS <> Sy, --"-- kall feil-prosedyren. ; if HS <> Sy then begin
  164. Feil4("Det skulle kommet ", TextAvSymbol(Sy), " n}, ikke ", TextAvSymbol(HS)); end if; end Forvent;
  165. procedure LesBetingelse(TestAdresse); name TestAdresse; integer TestAdresse; begin
  166. comment Les en betingelse. Adressen til den instruksjonen som hopper --"-- hvis betingelsen var gal (= `false'), returneres i TestAdresse. ; integer BetOp; if RTestUtskrift then TestProc1("Betingelse");
  167. LesUttrykk; Forvent(Hsammenlign); BetOp := BS; LagInstr(Isti, TempBetingelse, 0); Call(Sgen); LesUttrykk; LagInstr(Isubi, TempBetingelse, 0);
  168. TestAdresse := NesteInstr; LagInstr(BetOpKode(BetOp), -1, 0); if RTestUtskrift then TestProc2("Betingelse"); end LesBetingelse; procedure LesCallSetning;
  169. begin ref(VarInfo) VIP; if RTestUtskrift then TestProc1("CallSetning"); Call(Sgen); Forvent(Hnavn);
  170. inspect FinnDeklarasjon(BS) when ProsedyreDeklarasjon do begin Call(Sgen); if HarInnParam then begin Forvent(Hwith); Call(Sgen); LesUttrykk;
  171. end if; LagInstr(Ijrc, Adresse, 0); if HarUtParam then begin Forvent(Hinto); Call(Sgen); LagSettVar(LesVariabel);
  172. end if; end otherwise Feil2(NavnAvTall(BS), " er ikke en prosedyre"); if RTestUtskrift then TestProc2("CallSetning"); end LesCallSetning;
  173. procedure LesDeklListe(Termin); integer Termin; begin comment Les en liste av deklarasjoner terminert av symbolet Termin. ;
  174. if RTestUtskrift then TestProc1("DeklListe"); while HS <> Termin do begin if HS = Hvar then LesVarDekl else if HS = Hproc then LesProcDekl else
  175. Feil2("En deklarasjon m} starte med VAR eller PROC, ikke ", TextAvSymbol(HS)); Forvent(Hsemikolon); Call(Sgen); end while;
  176. if RTestUtskrift then TestProc2("DeklListe"); end LesDeklListe; procedure LesIfSetning; begin
  177. integer TestAdresse, ElseAdresse; if RTestUtskrift then TestProc1("IfSetning"); Call(Sgen); LesBetingelse(TestAdresse); Forvent(Hthen); Call(Sgen); LesSetnListe(Helse, Hendif);
  178. if HS = Helse then begin ElseAdresse := NesteInstr; LagInstr(Ijmp, -1, 0); FyllGammelAdr(TestAdresse, NesteInstr); Call(Sgen); LesSetnListe(Hendif, -1);
  179. FyllGammelAdr(ElseAdresse, NesteInstr); end else begin FyllGammelAdr(TestAdresse, NesteInstr); end if;
  180. Call(Sgen); if RTestUtskrift then TestProc2("IfSetning"); end LesIfSetning; procedure LesOutintSetning;
  181. begin integer Bredde; if RTestUtskrift then TestProc1("OutintSetning"); Call(Sgen); Forvent(Hvenstrepar);
  182. Call(Sgen); Forvent(Hkonst); Bredde := BS; Call(Sgen); Forvent(Hhoyrepar); Call(Sgen); LesUttrykk; LagInstr(Iouti, Bredde, 0); if RTestUtskrift then TestProc2("OutintSetning");
  183. end LesOutintSetning; procedure LesOutlineSetning; begin if RTestUtskrift then TestProc1("OutlineSetning");
  184. LagInstr(Iolin, 0, 0); Call(Sgen); if RTestUtskrift then TestProc2("OutlineSetning"); end LesOutlineSetning; procedure LesProcDekl;
  185. begin ref(ProsedyreDeklarasjon) PD; integer PDnavn; integer InnParamAdr, UtParamAdr, ReturAdrAdr;
  186. if RTestUtskrift then TestProc1("ProcDekl"); Call(Sgen); Forvent(Hnavn); PDnavn:=bs; PD :- new ProsedyreDeklarasjon(PDnavn, NesteInstr); NyDeklarasjon(PD); ReturAdrAdr := SettAvVariabel(PDnavn);
  187. InnIProsedyre; Call(Sgen); if HS<>Hin and HS<>Hout and HS<>Hsemikolon then Feil2("Her kan det st} IN, OUT eller `;', ikke ", TextAvSymbol(HS));
  188. if HS = Hin then begin Call(Sgen); Forvent(Hnavn); PD.HarInnParam := true; InnParamAdr := SettAvVariabel(BS); NyDeklarasjon(new VarDeklarasjon(BS,InnParamAdr));
  189. Call(Sgen); end if; if HS<>Hout and HS<>Hsemikolon then Feil2("Her kan det st} OUT eller `;', ikke ", TextAvSymbol(HS));
  190. if HS = Hout then begin Call(Sgen); Forvent(Hnavn); PD.HarUtParam := true; UtParamAdr := SettAvVariabel(BS); NyDeklarasjon(new VarDeklarasjon(BS,UtParamAdr));
  191. Call(Sgen); end if; LagInstr(Istc, ReturAdrAdr, 0); if PD.HarInnParam then LagInstr(Isti, InnParamAdr, 0);
  192. Forvent(Hsemikolon); Call(Sgen); LesDeklListe(Hbegproc); Call(Sgen); LesSetnListe(Hendproc,-1); Call(Sgen); if PD.HarUtParam then LagInstr(Ildi, UtParamAdr, 0); LagInstr(Ildc, ReturAdrAdr, 0);
  193. LagInstr(Ijmp, 0, 1); UtAvProsedyre; if RTestUtskrift then TestProc2("ProcDekl"); end LesProcDekl;
  194. procedure LesProgram; begin if RTestUtskrift then TestProc1("Program"); LagInstr(Ijmp, -1, 0);
  195. Forvent(Hprog); Call(Sgen); LesDeklListe(Hbegprog); FyllGammelAdr(0, NesteInstr); Call(Sgen); LesSetnListe(Hendprog,-1); LagInstr(Istop, 0, 0);
  196. if RTestUtskrift then TestProc2("Program"); end LesProgram; procedure LesSetnListe(Termin1, Termin2); integer Termin1, Termin2;
  197. begin comment Les en setningsliste som avsluttes av ett av de to terminator- --"-- symbolene Termin1 eller Termin2. (Hvis listen kun har ett --"-- terminator-symbol, kan den andre parameteren settes til -1.) ;
  198. if RTestUtskrift then TestProc1("SetnListe"); while HS<>Termin1 and HS<>Termin2 do begin if HS = Hcall then LesCallSetning else if HS = Hif then LesIfSetning else
  199. if HS = Houtint then LesOutintSetning else if HS = Houtline then LesOutlineSetning else if HS = Hwhile then LesWhileSetning else if HS = Hnavn then LesTilordning else
  200. Feil2("En setning kan ikke starte med ", TextAvSymbol(HS)); Forvent(Hsemikolon); Call(Sgen); end while; if RTestUtskrift then TestProc2("SetnListe");
  201. end LesSetnListe; procedure LesTilordning; begin ref(VarInfo) VenstreSide;
  202. if RTestUtskrift then TestProc1("Tilordning"); VenstreSide :- LesVariabel; Forvent(Htilordn); Call(Sgen); LesUttrykk; LagSettVar(VenstreSide); if RTestUtskrift then TestProc2("Tilordning");
  203. end LesTilordning; procedure LesUttrykk; begin procedure LesOperand1;
  204. begin comment Leser f|rste (og muligens eneste) operand i et uttrykk. ; if HS = Hnavn then begin LagHentVar(LesVariabel);
  205. end else if HS = Hkonst then begin LagInstr(Iseti, BS, 0); Call(Sgen); end else
  206. if HS = Hinint then begin LagInstr(Iini, 0, 0); Call(Sgen); end else Feil2(TextAvSymbol(HS), " kan ikke brukes som operand i uttrykk");
  207. end LesOperand1; procedure LesOperand2(Opp); integer Opp; begin
  208. comment Leser andre operand til operatoren Op. ; ref(VarInfo) VI; if HS = Hnavn then begin VI :- LesVariabel;
  209. if VI.Indeksert then begin if VI.VarIndeks then LagInstr(Ildc, VI.IndeksAdr, 0) else LagInstr(Isetc, VI.IndeksVerdi, 0); end if;
  210. LagInstr(AritOpKode(Opp), VI.Adresse, if VI.Indeksert then 1 else 0); end else if HS = Hkonst then begin LagInstr(AritOpKode(Opp), SettAvKonstant(BS), 0);
  211. Call(Sgen); end else if HS = Hinint then begin LagInstr(Icic, 0, 0); LagInstr(Iini, 0, 0);
  212. LagInstr(Isti, TempUttrykk, 0); LagInstr(Icci, 0, 0); LagInstr(AritOpKode(Opp), TempUttrykk, 0); Call(Sgen); end else
  213. Feil2(TextAvSymbol(HS), " kan ikke brukes som operand i uttrykk"); end LesOperand2; integer OpNum; if RTestUtskrift then Testproc1("Uttrykk");
  214. LesOperand1; while HS = Haritop do begin OpNum := BS; Call(Sgen); LesOperand2(OpNum); end while;
  215. if RTestUtskrift then Testproc2("Uttrykk"); end LesUttrykk; procedure LesVarDekl; begin
  216. procedure LesNyVar; begin comment Les en ny variabel i en variabel-deklarasjon. ; integer VarId, MaxElem;
  217. Forvent(Hnavn); VarId := BS; Call(Sgen); if HS = Hvenstrepar then begin Call(Sgen); Forvent(Hkonst); MaxElem := BS; NyDeklarasjon(new VektorDeklarasjon(VarId,
  218. SettAvVektor(MaxElem+1,VarId))); Call(Sgen); Forvent(Hhoyrepar); Call(Sgen); end else begin NyDeklarasjon(new VarDeklarasjon(VarId,SettAvVariabel(VarId)));
  219. end; end LesNyVar; if RTestUtskrift then TestProc1("VarDekl"); Call(Sgen); LesNyVar;
  220. while HS = Hkomma do begin Call(Sgen); LesNyVar; end while; if RTestUtskrift then TestProc2("VarDekl");
  221. end LesVarDekl; ref(VarInfo) procedure LesVariabel; begin comment Leser en <Variabel>, men lager ingen kode. ;
  222. ref(Deklarasjon) VD, ID; ref(VarInfo) VI; if RTestUtskrift then TestProc1("Variabel"); Forvent(Hnavn); VD :- FinnDeklarasjon(BS);
  223. if VD is ProsedyreDeklarasjon then Feil2(NavnAvTall(VD.Navn), " er en prosedyre, ikke en variabel"); LesVariabel :- VI :- new VarInfo(VD.Adresse); Call(Sgen);
  224. if HS = Hvenstrepar then begin if VD is VarDeklarasjon then Feil2(NavnAvTall(VD.Navn), " er en vanlig variabel, og kan ikke indekseres");
  225. VI.Indeksert := true; Call(Sgen); if HS = Hnavn then begin ID :- FinnDeklarasjon(BS); if not(ID is VarDeklarasjon) then
  226. Feil2("En indeks m} v{re en vanlig variabel; det er ikke ", NavnAvTall(ID.Navn)); VI.VarIndeks := true; VI.IndeksAdr := ID.Adresse; end else
  227. if HS = Hkonst then begin VI.IndeksVerdi := BS; end else Feil2("En indeks m} v{re et navn eller en konstant, ikke ",
  228. TextAvSymbol(HS)); Call(Sgen); Forvent(Hhoyrepar); Call(Sgen); end else begin if VD is VektorDeklarasjon then
  229. Feil2(NavnAvTall(VD.Navn), " er en vektor, og skulle v{rt indeksert"); end if; if RTestUtskrift then TestProc2("Variabel"); end LesVariabel;
  230. procedure LesWhileSetning; begin integer WhileStart, TestAdresse; if RTestUtskrift then TestProc1("WhileSetning");
  231. WhileStart := NesteInstr; Call(Sgen); LesBetingelse(TestAdresse); Forvent(Hdo); Call(Sgen); LesSetnListe(Hendwhile, -1); Call(Sgen); LagInstr(Ijmp, WhileStart, 0);
  232. FyllGammelAdr(TestAdresse, NesteInstr);  if RTestUtskrift then TestProc2("WhileSetning"); end LesWhileSetning;
  233. begin procedure DefInstr(Id, Instr, InstrKode); name Instr; text Id;
  234. integer Instr, InstrKode; begin comment Definer en ny Flink-instruksjon. ; Instr := InstrKode; InstrNavn(InstrKode) :- Id;
  235. end DefInstr; integer X; boolean GammelNTest; GammelNTest := NTestUtskrift;
  236. NTestUtskrift := false; TempUttrykk := SettAvKonstant(0); TempBetingelse := SettAvKonstant(0); DefInstr("STOP", Istop, 0); DefInstr("LDI", Ildi, 1);
  237. DefInstr("STI", Isti, 2); DefInstr("LDC", Ildc, 3); DefInstr("STC", Istc, 4); DefInstr("ADDI", Iaddi, 5); DefInstr("SUBI", Isubi, 6); DefInstr("MULI", Imuli, 7); DefInstr("DIVI", Idivi, 8); DefInstr("INI", Iini, 9);
  238. DefInstr("OUTI", Iouti, 10); DefInstr("OLIN", Iolin, 11); DefInstr("JMP", Ijmp, 12); DefInstr("JRC", Ijrc, 13); DefInstr("JLTI", Ijlti, 14); DefInstr("JLEI", Ijlei, 15); DefInstr("JEQI", Ijeqi, 16); DefInstr("JNEI", Ijnei, 17);
  239. DefInstr("JGTI", Ijgti, 18); DefInstr("JGEI", Ijgei, 19); DefInstr("SETI", Iseti, 20); DefInstr("INCI", Iinci, 21); DefInstr("SETC", Isetc, 22); DefInstr("INCC", Iincc, 23); DefInstr("CIC", Icic, 24); DefInstr("CCI", Icci, 25);
  240. AritOpKode(Bpluss) := Iaddi; AritOpKode(Bminus) := Isubi; AritOpKode(Bganger) := Imuli; AritOpKode(Bdivisjon) := Idivi; BetOpKode(Bmindre) := Ijlei; BetOpKode(Bmindrelik) := Ijlti; BetOpKode(Blik) := Ijnei; BetOpKode(Bulik) := Ijeqi;
  241. BetOpKode(Bstorre) := Ijgei; BetOpKode(Bstorrelik) := Ijgti; NTestUtskrift := GammelNTest; end Initialisering; Detach;
  242. Call(Sgen); LesProgram; end FlinkGenerator; text procedure TextAvChar(C); character C;
  243. begin comment Lag en text av lengde 1 som inneholder C. ; text T; TextAvChar :- T :- Blanks(1); T.PutChar(C);
  244. end TextAvChar; text procedure TextAvSymbol(S); integer S; begin
  245. comment Lag en tekstlig representasjon av symbolet S. ; if S=Hnavn then TextAvSymbol :- "et navn" else if S=Hkonst then TextAvSymbol :- "en tall-konstant" else if S=Haritop then TextAvSymbol :- "en aritmetisk operator" else
  246. if S=Hsammenlign then TextAvSymbol :- "en sammenligningsoperator" else if S=Hvenstrepar then TextAvSymbol :- "`('" else if S=Hhoyrepar then TextAvSymbol :- "`)'" else if S=Hkomma then TextAvSymbol :- "`,'" else
  247. if S=Hsemikolon then TextAvSymbol :- "`;'" else if S=Htilordn then TextAvSymbol :- "`:='" else TextAvSymbol :- NavnAvTall(S); end TextAvSymbol;
  248. begin character C; FM :- new Flink(400,400,1); NavneTab :- new Head;
  249. LokalDeklListe :- new Head; GlobalDeklListe :- new Head; Hbegproc := TallAvNavn("BEGPROC"); Hbegprog := TallAvNavn("BEGPROG"); Hcall := TallAvNavn("CALL"); Hdo := TallAvNavn("DO"); Helse := TallAvNavn("ELSE"); Hendif := TallAvNavn("ENDIF");
  250. Hendproc := TallAvNavn("ENDPROC"); Hendprog := TallAvNavn("ENDPROG"); Hendwhile := TallAvNavn("ENDWHILE"); Hif := TallAvNavn("IF"); Hin := TallAvNavn("IN"); Hinint := TallAvNavn("ININT"); Hinto := TallAvNavn("INTO"); Hout := TallAvNavn("OUT");
  251. Houtint := TallAvNavn("OUTINT"); Houtline := TallAvNavn("OUTLINE"); Hproc := TallAvNavn("PROC"); Hprog := TallAvNavn("PROG"); Hthen := TallAvNavn("THEN"); Hvar := TallAvNavn("VAR"); Hwhile := TallAvNavn("WHILE"); Hwith := TallAvNavn("WITH");
  252. Hnavn := 23; Hkonst := 24; Haritop := 25; Hsammenlign := 26;
  253. Hvenstrepar := 27; Hhoyrepar := 28; Hkomma := 29; Hsemikolon := 30; Htilordn := 31; Bpluss := 1; Bminus := 2; Bganger := 3; Bdivisjon := 4;
  254. Bmindre := 1; Bmindrelik := 2; Blik := 3; Bulik := 4; Bstorre := 5; Bstorrelik := 6; TestMarg1 := 12; TestMarg2 := 32; Tgen :- new TegnGenerator;
  255. Sgen :- new SymbolGenerator; Fgen :- new FlinkGenerator; end initiering; Call(Fgen);
  256. begin character C; FM.Run; end;
  257. goto avslutt; error: sysout.image:=""; Avslutt:
  258. Tgen.LukkFil; inspect ListeFil do Close; if sysout.image.strip="   2   3   5   7  11  13  17  19  23  29  31  37" then begin
  259. sysout.image:=""; sysout.setpos(1); Outtext("Installation: No errors found"); outimage;
  260. end else begin sysout.image:=""; sysout.setpos(1);
  261. Outtext("*** Installation: Errors found ***"); outimage; end; end program
  262. %eof
  263.